home *** CD-ROM | disk | FTP | other *** search
- { Show EGA 64 Colors }
-
- uses Txt;
-
- { ─────────────── ShowColor ─────────────── }
- procedure ShowColor(X,Y,LenX:integer);
- var I,K,P:integer;
- St:string[2];
- C:array[0..16] of byte;
- begin
- P:=1;
- TextBar(1, 1,80,1,$1F,' ');
- TextBar(1,25,80,1,$1F,' ');
- PrintChar(3, 1,'Show EGA 64 Colors');
- PrintChar(3,25,'Up,Down,PgUp,PgDn,Home,End-Scroll colors Esc-Exit');
- repeat
- for I:=1 to 15 do C[I]:=P+I-1; C[0]:=1; C[16]:=0;
- SetPalette17(C);
- for I:=0 to 14 do begin
- Str(P+I:2,St); PrintText(X,Y+I,15,St);
- TextBar(X+3,Y+I,LenX,1,I+1,'█');
- end;
- K:=Key;
- case K of
- $4800:Dec(P); $5000:Inc(P); { Up,Down }
- $4900:Dec(P,8); $5100:Inc(P,8); { PgUp,PgDn }
- $4700:P:=1; $4F00:P:=49; { Home,End }
- end;
- if P<1 then P:=1; if P>49 then P:=49;
- until K=$011B; { Esc }
- end;
-
- begin
- VideoMode(3);
- TextBar(1,1,80,25,7,' ');
- ShowColor(18,6,40);
- VideoMode(3);
- end.
-